module LLVM.Parser.Block.BlockParser where

import LLVM.Util

import Control.Monad
import Control.Monad.Trans

import Control.Monad.TreeGenerator
import LLVM.Parser.Record.TreeGenerator.Instances

import LLVM.Parser.Record.Struct

import LLVM.Parser.Record.BlockInfo
import LLVM.Parser.Record.Parser
import LLVM.Parser.Record.Record

-- all we need to do with binfo is pick up all records
pickBlockInfo :: BlockHeader -> ElemCollector
pickBlockInfo bh = let loop = do
                                 rec <- lift readRecord
                                 -- mdebug $ "record: " ++ (show $ recordAsList rec)
                                 unless (isBlockClosing rec) $ do yield rec
                                                                  loop
                                 --mdebug "loop end"
                   in do
                             s <- lift $ getBlockContext --`debug` "saving block context"
                             lift $ assumeBlockHead bh --`debug` ("assuming head: " ++ show bh)
                             loop -- `debug` "loop start"
                             lift $ putBlockContext s --`debug` "loading block context"
                             return ()
                                 

virtualDefaultHeader :: BlockHeader
virtualDefaultHeader = BlockHeader (-1) 0 2

pickBlock :: BlockHeader -> ElemCollector
pickBlock bh = let loop = do
                           rec <- lift readRecord
                           -- s <- lift getBlockContext
                           -- mdebug $ "record: " ++ (show $ recordAsList rec)
                           if (isBlockEntry rec {- `debug` ("record: " ++ show rec) -} )
                             then do
                                    head <- lift $ 
                                              promoteMaybe 
                                                (fromRawRecord rec) 
                                                "Record marked as blockheader is not a header"
                                    if(blockId head == 0 ) 
                                        then lift $ do
                                               raws <- collect $ pickBlockInfo head --`debug` "collecting info"
                                               -- mdebug "converting info block to info"
                                               bi <- promoteMaybe 
                                                        (fromRawBlock $ RawBlock head raws) 
                                                        "Block info parsing error"
                                               assumeBlockInfos bi --`debug` ("accepting info block:" ++ show bi)
                                        else gbranch (pickBlock head) head --`debug` ("adding sub block:" ++ show head)
                             else if (isAbbrDefinition rec)
                                    then ignorem $ lift $ consumeAbbreviation rec --`debug` ("abbr definition:" ++ show ((fromRawRecord rec)::Maybe AbbreviationDef)) 
                                    else if (not $ isBlockClosing rec)
                                           then yield rec -- `debug` ("adding record:" ++ show rec)
                                           else skipm
                           eof <- lift isEof
                           unless (isBlockClosing rec || eof) loop --`debug` "\tnext step"
                           -- mdebug "loop exit"
               in do
                     s <- lift $ getBlockContext --`debug` "saving block context"
                     lift $ assumeBlockHead bh --`debug` ("assuming head: " ++ show bh)
                     loop --`debug` "loop start"
                     lift $ putBlockContext s --`debug` "loading block context"
                     return ()
                 
readScatter :: ErrParser [RawBlockElem]
readScatter =  do 
                elems <- collect (pickBlock virtualDefaultHeader) -- `debug` "reading top body"
                return elems -- `debug` "finished"
                